We downloaded data from Census.gov using the get_acs function, did some data wrangling and cleaning, wrote them as a csv file so that we can import them into RMarkdown

#code_folding: "hide" (hides the code but ppl can see the code if they want to)
knitr::opts_chunk$set(echo =  TRUE, warning = FALSE, message = FALSE) #doesn't show the messages or the warings, only code output, must be its in own code chunk to apply to all the subsequent ones

Basic summary statistics:

How many renters are there in each county? of which demographics?

Petersburg, Hopewell, Charlottesville and Richmond have the highest percentage of renters (overall). Below is a table of the dempographics of renters in each county.

Tenure_By_Race_Perc <- Tenure_By_Race %>% 
  mutate(Perc_rentersE = (RentersE/Total_OccupantsE), Perc_ownersE = (OwnersE/Total_OccupantsE)) %>% 
  group_by(County) %>% 
  summarize(Renters = median(Perc_rentersE, na.rm = TRUE), Owners = median(Perc_ownersE, na.rm = TRUE), White_Renters = median((White_rentersE/RentersE), na.rm = TRUE), White_Owners = median((White_ownersE/OwnersE), na.rm = TRUE), Black_Renters = median((Black_rentersE/RentersE), na.rm = TRUE), Black_Owners = median((Black_ownersE/OwnersE), na.rm = TRUE), NativeAm_Owners = median((NativeAm_ownersE/OwnersE), na.rm = TRUE), NativeAm_Renters = median((NativeAm_rentersE/RentersE), na.rm = TRUE),  Asian_Owners = median((Asian_ownersE/OwnersE), na.rm = TRUE), Asian_Renters = median((Asian_rentersE/RentersE), na.rm = TRUE), PacificIslander_Owners = median((PacificIslander_ownerE/OwnersE), na.rm = TRUE), PacificIslander_Renters = median((PacificIslander_renterE/RentersE), na.rm = TRUE), HispanicLatino_Owners = median((HispanicLatino_ownerE/OwnersE), na.rm = TRUE), HispanicLatino_Renters = median((HispanicLation_renterE/RentersE), na.rm = TRUE)) %>% 
  mutate(across(c(2:14), scales::percent)) %>% 
  arrange(desc(Renters)) %>% 
  select(1:3,4,6,9,11,13,15,5,7,8,10,12,14)


sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'County'),
      th(colspan = 6, 'Renters'),
      th(colspan = 6, 'Owners')
    ),
    tr(
      lapply(c('White_Renters', 'Black_Renters', 'NativeAm_Renters', 'Asian_Renters', "PacificIslander_Renters", "HispanicLatino_Renters", 'White_Owners', 'Black_Owners', 'NativeAm_Owners', 'Asian_Owners', "PacificIslander_Owners", "HispanicLatino_Owners"), th)
    )
  )
))

DT_Tenure_By_Race <- Tenure_By_Race_Perc[,c(1,4:15)]

datatable(DT_Tenure_By_Race, 
          caption = htmltools::tags$caption(
            style = 'caption-side: bottom; text-align: center;',
            'Table 1: ', htmltools::em('Median Percentage of Renters and Owners in Each County (by Demographics)')),
          container = sketch, 
          rownames = FALSE, 
          extensions = 'Buttons', 
          options = list(dom='Bfrtip',
                         buttons=c('copy', 'csv', 'excel', 'print', 'pdf')
                         )
          )

We also graphed the racial composition of renters, comparing Charlottesville and Richmond.

Tenure_perc_by_race <- Tenure_By_Race %>% 
  mutate(Perc_WRenters = (White_rentersE/RentersE), Perc_WOwners = (White_ownersE/OwnersE), Perc_BRenters = (Black_rentersE/RentersE), Perc_BOwners = (Black_ownersE/OwnersE), Perc_NativeAmOwners = (NativeAm_ownersE/OwnersE), Perc_NativeAmRenters = (NativeAm_rentersE/RentersE),  Perc_AsianOwners = (Asian_ownersE/OwnersE), Perc_AsianRenters = (Asian_rentersE/RentersE), Perc_PacificIslanderOwner = (PacificIslander_ownerE/OwnersE), Perc_PacificIslanderRenter = (PacificIslander_renterE/RentersE), Perc_HispanicLatinoOwner = (HispanicLatino_ownerE/OwnersE), Perc_HispanicLationRenterE = (HispanicLation_renterE/RentersE)) %>%
  select(1:5, 48:59)

Tenure_perc_by_race <- Tenure_perc_by_race %>%
  pivot_longer(., cols = c(Perc_AsianOwners, Perc_WRenters, Perc_WOwners, Perc_BOwners, Perc_BRenters, Perc_NativeAmOwners, Perc_NativeAmRenters, Perc_AsianRenters, Perc_PacificIslanderOwner, Perc_PacificIslanderRenter, Perc_HispanicLatinoOwner, Perc_HispanicLationRenterE), names_to = "Variable", values_to = "Percentage (Estimated)") %>% 
  mutate(Race = case_when(
    str_detect(Variable, "Asian") ~ "Asian",
    str_detect(Variable, "B") ~ "Black",
    str_detect(Variable, "NativeAm") ~ "Native American",
    str_detect(Variable, "PacificIslander") ~ "Pacific Islander",
    str_detect(Variable, "Hispanic") ~ "Hispanic or Latino",
    str_detect(Variable, "WRenters") ~ "White",
    str_detect(Variable, "WOwners") ~ "White"
  ), 
  Variable = case_when(
    str_detect(Variable, "Owner") ~ "Owner",
    str_detect(Variable, "Renter") ~ "Renter"
  )) 


Tenure_perc_by_race <- rename(Tenure_perc_by_race, Tenure_Type = Variable)



Tenure_perc_by_race %>% 
  filter(Tenure_Type == "Renter" & Race %in% race ) %>% 
  ggplot(aes(x = Tenure_Type, y = `Percentage (Estimated)`, fill = Race)) +
  scale_fill_viridis_d() +
  geom_boxplot() + 
  facet_wrap(~Region) +
  labs(title = "Racial Composition of Renters in Charlottesville and Richmond, Virginia", x = "Tenure Type")

What is the average rent, income, and real estate taxes paid in each County?

Highest rent: Fluvanna, Chesterfield, Henrico and Albemarle Highest median real estate taxes: Albemare, Charlottesville, Richmond, and Chesterfeild

ACS_Housing_Data |>
  group_by(County) |>
  summarize(Median_rent = median(MedianRentE, na.rm = TRUE), Median_tax = median(MedianTaxesE, na.rm = TRUE), Median_income = median(MedianIncomeE, na.rm = TRUE))
## # A tibble: 11 × 4
##    County          Median_rent Median_tax Median_income
##    <chr>                 <dbl>      <dbl>         <dbl>
##  1 Albemarle             1323       2657         55964 
##  2 Charlottesville       1181       2622.        40104 
##  3 Chesterfield          1333       1935         60040 
##  4 Fluvanna              1419       1786         49581 
##  5 Greene                 974.      1636.        51240.
##  6 Henrico               1214       1923         53133 
##  7 Hopewell               910.      1104.        28625 
##  8 Louisa                 875       1432         46964 
##  9 Nelson                 918.      1357         44754 
## 10 Petersburg City        952       1067         34167 
## 11 Richmond City         1085       2148         37975

What is the average rent to tax ratio (measure of rent exploitation) in each county?

Highest Rent Tax Ratio: Petersburg City, Chesterfeild, and Nelson

Tenure_and_Housing_Data <- full_join(Tenure_perc_by_race, ACS_Housing_Data, by = "GEOID") %>%
  select(1,6:30)

ACS_Housing_Data$RentTaxRatio <- round(ACS_Housing_Data$RentTaxRatio, 3)

Tenure_and_Housing_Data %>% 
  filter(`Percentage (Estimated)` >= 0.5, Race == "Black", Tenure_Type == "Renter") %>% 
   group_by(County.y) %>% 
  summarize(Rent_Tax_RaTio_Black = median(RentTaxRatio, na.rm = TRUE))
## # A tibble: 6 × 2
##   County.y        Rent_Tax_RaTio_Black
##   <chr>                          <dbl>
## 1 Chesterfield                   0.754
## 2 Henrico                        0.791
## 3 Hopewell                       0.859
## 4 Nelson                         0.962
## 5 Petersburg City                0.790
## 6 Richmond City                  0.589

Here is a look at the rent to tax ratio (measure of rent exploitation) across both regions

counties <- c("Albemarle", "Charlottesville", "Fluvanna", "Greene", "Louisa", "Nelson", "Richmond city", "Henrico", "Chesterfield", "Hopewell", "Petersburg")
countytracts <- tracts(state = "VA", county = counties, year = 2020)

countytracts <- countytracts |>
  mutate(GEOID = as.numeric(countytracts$GEOID)) 
HousingDataSpatial <- full_join(ACS_Housing_Data, countytracts, by = "GEOID") |>
  sf::st_as_sf() |>
  mutate(INTPTLAT = as.numeric(countytracts$INTPTLAT), INTPTLON = as.numeric(countytracts$INTPTLON))|> 
   sf::st_transform(crs = '+proj=longlat +datum=WGS84') 


pal <-  colorNumeric("YlOrRd", HousingDataSpatial$RentTaxRatio, reverse = TRUE)

HousingDataSpatial %>% 
leaflet() %>% 
  addTiles() %>% 
  addPolygons(color = "black",
              fillColor = ~pal(RentTaxRatio),
              fillOpacity = 0.6,
              weight = 2,
              highlight = highlightOptions(
                weight = 3,
                fillOpacity = 0.9,
                bringToFront = T),
              popup = paste0("County: ", HousingDataSpatial$County, "<br>",
                             "Tract: ", HousingDataSpatial$NAMELSAD, "<br>",
                             "Rent to Tax Ratio: ", HousingDataSpatial$RentTaxRatio)) %>% 
  addLegend(pal = pal, 
            values = ~RentTaxRatio, 
            opacity = 0.7, 
            title = "Rent to Tax Ratio (2020)", 
            position = "bottomleft")

What is the average percent of rent of income in each county? Thus, which county is the most rent burdened?

Richmond, Charlottesville and Nelson are the most rent burdened counties, but no counties appear to be severly rent burdened (more than 50), on average.

ACS_Housing_Data %>% 
  group_by(County) %>% 
  summarize(Median_perc_rent_income = median(PercRentBurdenE, na.rm = TRUE)) %>% 
  arrange(desc(Median_perc_rent_income))
## # A tibble: 11 × 2
##    County          Median_perc_rent_income
##    <chr>                             <dbl>
##  1 Richmond City                      32.6
##  2 Charlottesville                    31.9
##  3 Hopewell                           31.4
##  4 Henrico                            28.6
##  5 Albemarle                          27.9
##  6 Petersburg City                    27.8
##  7 Chesterfield                       27.5
##  8 Greene                             27  
##  9 Louisa                             26.6
## 10 Nelson                             23.8
## 11 Fluvanna                           21.3

Here is a more detailed look at who’s rent burded and severely rent burdened in each County, with Richmond still being the most rent burdened.

ACS_Housing_Data <- ACS_Housing_Data %>% 
  mutate(Rent_Burdened = case_when(
    PercRentBurdenE >= 30 & PercRentBurdenE < 50  ~ "Yes",
    PercRentBurdenE >= 50 ~"Yes, Severely",
    TRUE ~ "No")
    ) 

Rent_Burden_stats <- ACS_Housing_Data %>% 
  filter(Rent_Burdened != "No") %>% 
  group_by(Rent_Burdened,  County) %>% 
  summarize(Percent = round((n()/317)*100, 3)) %>% 
  arrange(desc(Percent))

knitr::kable(Rent_Burden_stats)
Rent_Burdened County Percent
Yes Richmond City 13.565
Yes Henrico 10.095
Yes Chesterfield 6.940
Yes Albemarle 3.155
Yes Charlottesville 2.208
Yes Petersburg City 1.262
Yes, Severely Richmond City 1.262
Yes Hopewell 0.946
Yes Louisa 0.946
Yes, Severely Chesterfield 0.946
Yes, Severely Albemarle 0.315
Yes, Severely Fluvanna 0.315
Yes, Severely Henrico 0.315
Yes, Severely Nelson 0.315

As we can see here, although it may not look like it from the numbers above, a lot of counties (the biggest census tracts too) are rent burdened, some even severely.

pal1 <-  colorNumeric("YlOrRd", HousingDataSpatial$PercRentBurdenE, reverse = TRUE)

HousingDataSpatial %>% 
leaflet() %>% 
  addTiles() %>% 
  addPolygons(color = "black",
              fillColor = ~pal1(PercRentBurdenE),
              fillOpacity = 0.6,
              weight = 2,
              highlight = highlightOptions(
                weight = 3,
                fillOpacity = 0.9,
                bringToFront = T),
              popup = paste0("County: ", HousingDataSpatial$County, "<br>",
                             "Tract: ", HousingDataSpatial$NAMELSAD, "<br>",
                             "Percentage of Rent Burden: ", HousingDataSpatial$PercRentBurdenE)) %>% 
  addLegend(pal = pal1, 
            values = ~PercRentBurdenE, 
            opacity = 0.7, 
            title = "Percentage of Rent Burden (2020)", 
            position = "bottomleft")

What does the income and ratio look like there?

Although these three are the most rent burdened, it isn’t obvious based on its rent to tax ratio and median household income, except for in Nelson county (which only has 5 observations in the tract)

  1. Richmond: Median Income is $53,216.5 and the Rent to Tax Ratio is 0.484
  2. Charlottesville: Median Income is $62,477.5 and the Rent to Tax Ratio is 0.4325
  3. Nelson: Median Income is $53,579 and the Rent to Tax Ratio is 0.71

Which county has the most students (includes Undergraduate and Graduate students)?

No one county has a disproportionate amount of students compared to the other, however, Richmond, Charlottesville, and Henrico have the highest student populations

 ACS_Housing_Data %>% 
  group_by(County) %>% 
  summarize(Median_perc_students = median(Perc_StudentsE, na.rm = TRUE))
## # A tibble: 11 × 2
##    County          Median_perc_students
##    <chr>                          <dbl>
##  1 Albemarle                       5.21
##  2 Charlottesville                 5.98
##  3 Chesterfield                    5.43
##  4 Fluvanna                        4.96
##  5 Greene                          3.16
##  6 Henrico                         5.59
##  7 Hopewell                        4.84
##  8 Louisa                          3.7 
##  9 Nelson                          4.96
## 10 Petersburg City                 4.8 
## 11 Richmond City                   6.59

*More than 50% of pop. in tracts in Richmond and Charlottesville city consist of students, but doesn’t seem like the case for Henrico!

perc_student_counties <- c("Richmond City", "Charlottesville", "Henrico")

Moststudents <- HousingDataSpatial %>% 
  filter(County %in% perc_student_counties)

pal2 <-  colorNumeric("YlOrRd", Moststudents$Perc_StudentsE, reverse = TRUE) #the reverse argument reverses the color palette 


Moststudents %>% 
  leaflet() %>% 
  addTiles() %>% 
  addPolygons(color = "black",
              fillColor = ~pal2(Perc_StudentsE),
              weight = 2,
              fillOpacity = 0.6,
              highlight = highlightOptions(
                weight = 3,
                fillOpacity = 0.9,
                bringToFront = T),
              popup = paste0("County: ", Moststudents$County, "<br>",
                             "Tract: ", Moststudents$NAMELSAD, "<br>",
                             "Percentage of Students: ", Moststudents$Perc_StudentsE)) %>%
  addLegend(pal = pal2, 
            values = ~Perc_StudentsE, 
            opacity = 0.7, 
            title = "Highest Percentage of Students in Charlottesville and Richmond regions for 2020", 
            position = "bottomleft")

Here’s a detailed look at which census tracts have the most students

HousingDataSpatial %>% 
  filter(Perc_StudentsE >= 50) %>% 
  select(3,22) %>% 
  arrange(desc(Perc_StudentsE))
## Simple feature collection with 8 features and 2 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -78.52874 ymin: 37.22587 xmax: -77.41441 ymax: 38.05642
## CRS:           +proj=longlat +datum=WGS84
## # A tibble: 8 × 3
##   NAME.x                                Perc_StudentsE                  geometry
##   <chr>                                          <dbl>        <MULTIPOLYGON [°]>
## 1 Census Tract 403, Richmond city, Vir…           90.5 (((-77.45652 37.54333, -…
## 2 Census Tract 109.04, Albemarle Count…           86.5 (((-78.52864 38.02705, -…
## 3 Census Tract 6, Charlottesville city…           71.9 (((-78.52363 38.0224, -7…
## 4 Census Tract 402.01, Richmond city, …           68.8 (((-77.45534 37.55372, -…
## 5 Census Tract 109.01, Albemarle Count…           65.9 (((-78.52472 38.0483, -7…
## 6 Census Tract 2.02, Charlottesville c…           60.4 (((-78.50342 38.03681, -…
## 7 Census Tract 1006, Chesterfield Coun…           60.4 (((-77.43459 37.23137, -…
## 8 Census Tract 305.01, Richmond city, …           54.9 (((-77.44895 37.54312, -…

What does the income, and ratio look like there (in counties with the most students)?

  1. Richmond: Median Income is $53,216.5 and the Rent to Tax Ratio is 0.484
  2. Charlottesville: Median Income is $62,477.5 and the Rent to Tax Ratio is 0.433
  3. Henrico: Median Income is $69,827 and the Rent to Tax Ratio is 0.659

How does this compare to the average gini index and who’s below poverty in each county?

Poverty_By_Race %>% 
  group_by(County) %>% 
  summarize(Median_perc_below_poverty = median(Perc_Total_BelowPovertyE, na.rm = TRUE), Median_Gini_Index = median(Gini_IndexE, na.rm = TRUE))
## # A tibble: 11 × 3
##    County          Median_perc_below_poverty Median_Gini_Index
##    <chr>                               <dbl>             <dbl>
##  1 Albemarle                            5.71             0.428
##  2 Charlottesville                     15.3              0.480
##  3 Chesterfield                         5.39             0.356
##  4 Fluvanna                             3.76             0.407
##  5 Greene                               9.22             0.390
##  6 Henrico                              7.54             0.394
##  7 Hopewell                            27.8              0.439
##  8 Louisa                              10.6              0.426
##  9 Nelson                              12.9              0.452
## 10 Petersburg City                     22.1              0.437
## 11 Richmond City                       17.7              0.448

Here’s a closer look at the Gini Index and the percentage of those below the poverty level in each coutny.

Poverty_Stats <- Poverty_By_Race %>% 
  filter(Gini_IndexE >= 0.5 & Perc_Total_BelowPovertyE >= 0.5) %>% 
  select(3,4,36,50) %>% 
  arrange(desc(Gini_IndexE))

knitr::kable(Poverty_Stats)
NAME County Gini_IndexE Perc_Total_BelowPovertyE
Census Tract 201.03, Fluvanna County, Virginia Fluvanna 0.7173 6.53
Census Tract 403, Richmond city, Virginia Richmond City 0.7044 66.57
Census Tract 305.01, Richmond city, Virginia Richmond City 0.6917 58.62
Census Tract 6, Charlottesville city, Virginia Charlottesville 0.6686 63.91
Census Tract 404, Richmond city, Virginia Richmond City 0.6400 39.70
Census Tract 207, Richmond city, Virginia Richmond City 0.6393 21.24
Census Tract 7, Charlottesville city, Virginia Charlottesville 0.6153 21.08
Census Tract 2008.05, Henrico County, Virginia Henrico 0.6129 32.49
Census Tract 1009.38, Chesterfield County, Virginia Chesterfield 0.6044 0.79
Census Tract 9501.02, Nelson County, Virginia Nelson 0.5953 17.73
Census Tract 2009.08, Henrico County, Virginia Henrico 0.5929 8.58
Census Tract 405, Richmond city, Virginia Richmond City 0.5811 14.40
Census Tract 104.01, Albemarle County, Virginia Albemarle 0.5762 5.29
Census Tract 210, Richmond city, Virginia Richmond City 0.5745 30.86
Census Tract 204, Richmond city, Virginia Richmond City 0.5731 50.49
Census Tract 8107, Petersburg city, Virginia Petersburg City 0.5605 22.63
Census Tract 413, Richmond city, Virginia Richmond City 0.5551 17.66
Census Tract 2.02, Charlottesville city, Virginia Charlottesville 0.5448 57.51
Census Tract 109.01, Albemarle County, Virginia Albemarle 0.5433 29.63
Census Tract 412, Richmond city, Virginia Richmond City 0.5417 32.50
Census Tract 109.04, Albemarle County, Virginia Albemarle 0.5407 29.15
Census Tract 4.01, Charlottesville city, Virginia Charlottesville 0.5317 18.69
Census Tract 209, Richmond city, Virginia Richmond City 0.5309 8.30
Census Tract 710.04, Richmond city, Virginia Richmond City 0.5306 50.90
Census Tract 2010.03, Henrico County, Virginia Henrico 0.5291 18.17
Census Tract 505, Richmond city, Virginia Richmond City 0.5284 2.57
Census Tract 605.02, Richmond city, Virginia Richmond City 0.5225 8.58
Census Tract 10, Charlottesville city, Virginia Charlottesville 0.5205 7.69
Census Tract 101, Albemarle County, Virginia Albemarle 0.5178 6.29
Census Tract 1009.26, Chesterfield County, Virginia Chesterfield 0.5125 1.94
Census Tract 501, Richmond city, Virginia Richmond City 0.5099 8.22
Census Tract 112.01, Albemarle County, Virginia Albemarle 0.5060 6.02
Census Tract 8106, Petersburg city, Virginia Petersburg City 0.5018 36.43
Census Tract 102.01, Richmond city, Virginia Richmond City 0.5017 7.02
Census Tract 8113, Petersburg city, Virginia Petersburg City 0.5014 34.61
Census Tract 109, Richmond city, Virginia Richmond City 0.5013 21.20

Which demographics are most likely to be below poverty and above (or at) in each county?

PovertyBy_Race_County <- Poverty_By_Race %>% 
  group_by(County) %>% 
  summarize(Median_Perc_WBelowPoverty = median((Perc_BelowPoverty_WhiteE), na.rm = TRUE), Median_Perc_BBelowPoverty = median((Perc_BelowPoverty_BlackE), na.rm = TRUE), Median_Perc_NativeAm_BelowPoverty = median((Perc_BelowPoverty_NativeAmE), na.rm = TRUE),  Median_Perc_Asian_BelowPoverty = median((Perc_BelowPoverty_AsianE), na.rm = TRUE), Median_Perc_PacificIslander_BelowPoverty = median((Perc_BelowPoverty_PacificIslanderE), na.rm = TRUE), Median_Perc_HispanicLatino_BelowPoverty = median((Perc_BelowPoverty_HispanicLatinoE), na.rm = TRUE))

knitr::kable(PovertyBy_Race_County)
County Median_Perc_WBelowPoverty Median_Perc_BBelowPoverty Median_Perc_NativeAm_BelowPoverty Median_Perc_Asian_BelowPoverty Median_Perc_PacificIslander_BelowPoverty Median_Perc_HispanicLatino_BelowPoverty
Albemarle 5.670 0.840 0.00 0.00 0 0.460
Charlottesville 11.020 14.575 0.00 19.48 0 17.900
Chesterfield 4.140 5.320 0.00 0.00 0 4.420
Fluvanna 3.730 3.690 0.00 0.00 0 0.000
Greene 6.595 9.340 0.00 2.38 NA 8.390
Henrico 5.860 7.080 0.00 0.00 0 0.865
Hopewell 20.820 33.050 0.00 0.00 NA 30.635
Louisa 9.000 20.730 0.00 0.00 NA 0.000
Nelson 4.500 2.750 NA 50.00 NA 0.000
Petersburg City 12.140 23.000 47.22 8.74 0 1.780
Richmond City 9.200 24.690 0.00 26.92 0 12.545

Is there any evidence of residential segragation in Charlottesville and Richmond, Virginia?

Here is a measure of the Exposure, via the Isolation Index of Black groups

#
 HDSpatial_Updated <- HousingDataSpatial %>%
   mutate(county_tract = paste(COUNTYFP,TRACTCE, sep = "")) 
#
 cvl_rva_measures_Spatial <- full_join(cvl_rva_measures, HDSpatial_Updated, by = "county_tract") %>%
   sf::st_as_sf() |>
   sf::st_transform(crs = 4326)
#
pal3 <-  colorNumeric("viridis", cvl_rva_measures_Spatial$iso_b_block, reverse = TRUE)

cvl_rva_measures_Spatial %>%
 leaflet() %>%
   addTiles() %>%
   addPolygons(color = "black",
               fillColor = ~pal3(iso_b_block),
               fillOpacity = 0.6,
               weight = 2,
               highlight = highlightOptions(
                 weight = 3,
                 fillOpacity = 0.9,
                 bringToFront = T),
               popup = paste0("County: ", cvl_rva_measures_Spatial$County, "<br>",
                              "Tract: ", cvl_rva_measures_Spatial$NAME.x, "<br>",
                              "Isolation Index: ", cvl_rva_measures_Spatial$iso_b_block)) %>%
  addLegend(pal = pal3,
             values = ~iso_b_block,
             opacity = 0.7,
            title = "Black Isolation Index (2020)",
             position = "bottomleft")

Here is a measure of Evenness, via the Dissimilarity Index between White and Black Groups

pal4 <-  colorNumeric("viridis", cvl_rva_measures_Spatial$dissim_wb_block, reverse = TRUE)

cvl_rva_measures_Spatial %>%
 leaflet() %>%
   addTiles() %>%
   addPolygons(color = "black",
               fillColor = ~pal4(dissim_wb_block),
               fillOpacity = 0.6,
               weight = 2,
               highlight = highlightOptions(
                 weight = 3,
                 fillOpacity = 0.9,
                 bringToFront = T),
               popup = paste0("County: ", cvl_rva_measures_Spatial$County, "<br>",
                              "Tract: ", cvl_rva_measures_Spatial$NAME.x, "<br>",
                              "Dissimilarity Index: ", cvl_rva_measures_Spatial$dissim_wb_block)) %>%
  addLegend(pal = pal4,
             values = ~dissim_wb_block,
             opacity = 0.7,
            title = "Whtie and Black Dissimilarity Index (2020)",
             position = "bottomleft")

Relationships (Linear Models)

The relationship between demographics of renters and rent expoitation

Tenure_and_Housing_Data  %>% 
  filter(Tenure_Type == "Renter" & Race %in% race) %>% 
  ggplot(aes(x = `Percentage (Estimated)`, y = RentTaxRatio, color = Region.y)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") + 
  facet_wrap(~Race) + 
  labs(title = "Demographic of Renter vs Rent Exploitation in Charlottesville and Richmond, VA", x = "Percentage of Renter (Estimated)", y = "Rent to Tax Ratio", color = "Region") 

#Below is the Linear Model Coefficient


lm1 <- lm(RentTaxRatio ~ `Percentage (Estimated)`:factor(Race), data = Tenure_and_Housing_Data)
lm1 
## 
## Call:
## lm(formula = RentTaxRatio ~ `Percentage (Estimated)`:factor(Race), 
##     data = Tenure_and_Housing_Data)
## 
## Coefficients:
##                                             (Intercept)  
##                                                  0.6365  
##              `Percentage (Estimated)`:factor(Race)Asian  
##                                                 -0.2752  
##              `Percentage (Estimated)`:factor(Race)Black  
##                                                  0.1288  
## `Percentage (Estimated)`:factor(Race)Hispanic or Latino  
##                                                  0.5291  
##    `Percentage (Estimated)`:factor(Race)Native American  
##                                                 -0.2271  
##   `Percentage (Estimated)`:factor(Race)Pacific Islander  
##                                                  2.1519  
##              `Percentage (Estimated)`:factor(Race)White  
##                                                 -0.0360

The relationship between demographics of renters and being rent burndened

#Graph

Tenure_and_Housing_Data  %>% 
  filter(Tenure_Type == "Renter" & Race %in% race) %>% 
  ggplot(aes(x = `Percentage (Estimated)`, y = PercRentBurdenE, color = Region.y)) +
  scale_color_viridis_d() +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") + 
  facet_wrap(~Race) +
  labs(title = "Demographic of Renter vs Rent Burden in CVL and RVA", x = "Percentage of Renter (Estimated)", y = "Rent as a Percentage of Income", color = "Region")

#Below is the Linear Model Coefficient


lm3 <- lm(PercRentBurdenE ~ Race:`Percentage (Estimated)`, data = Tenure_and_Housing_Data)
lm3
## 
## Call:
## lm(formula = PercRentBurdenE ~ Race:`Percentage (Estimated)`, 
##     data = Tenure_and_Housing_Data)
## 
## Coefficients:
##                                     (Intercept)  
##                                          30.431  
##              RaceAsian:`Percentage (Estimated)`  
##                                          -3.197  
##              RaceBlack:`Percentage (Estimated)`  
##                                           3.336  
## RaceHispanic or Latino:`Percentage (Estimated)`  
##                                           4.721  
##    RaceNative American:`Percentage (Estimated)`  
##                                          44.182  
##   RacePacific Islander:`Percentage (Estimated)`  
##                                         -46.827  
##              RaceWhite:`Percentage (Estimated)`  
##                                          -1.090

The relationship between those who are rent burdened and rent tax ratio

Tenure_and_Housing_Data %>% 
ggplot(aes(x = PercRentBurdenE, y = RentTaxRatio)) + 
  geom_point(alpha = 0.3) +
    geom_smooth(method = "lm") +
  facet_wrap(~Region.y)

#Below is the Linear Model Coefficient

lm5 <- lm(RentTaxRatio ~ PercRentBurdenE:Region.y, data = Tenure_and_Housing_Data)
lm5
## 
## Call:
## lm(formula = RentTaxRatio ~ PercRentBurdenE:Region.y, data = Tenure_and_Housing_Data)
## 
## Coefficients:
##                             (Intercept)  
##                               5.740e-01  
## PercRentBurdenE:Region.yCharlottesville  
##                              -3.710e-06  
##        PercRentBurdenE:Region.yRichmond  
##                               2.836e-03

The relationship between the those below the poverty level and the Gini index

Poverty_By_Race %>% 
  ggplot(aes(x = Perc_Total_BelowPovertyE, y = Gini_IndexE)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") +
  facet_wrap(~Region)

#Below is the Linear Model formula 

lm(Gini_IndexE ~ Perc_Total_BelowPovertyE:Region, data = Poverty_By_Race)
## 
## Call:
## lm(formula = Gini_IndexE ~ Perc_Total_BelowPovertyE:Region, data = Poverty_By_Race)
## 
## Coefficients:
##                                    (Intercept)  
##                                        0.38046  
## Perc_Total_BelowPovertyE:RegionCharlottesville  
##                                        0.00451  
##        Perc_Total_BelowPovertyE:RegionRichmond  
##                                        0.00250

The relationshiop between Rent exploitation and segregation meausres

#The Dissimilarity Index (Between White and Black)

cvl_rva_measures_Spatial %>% 
  ggplot(aes(x = dissim_wb_block, y = RentTaxRatio)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") +
  facet_wrap(~Region)

lm(RentTaxRatio ~ dissim_wb_block:Region, data = cvl_rva_measures_Spatial) #-0.4407
## 
## Call:
## lm(formula = RentTaxRatio ~ dissim_wb_block:Region, data = cvl_rva_measures_Spatial)
## 
## Coefficients:
##                           (Intercept)  dissim_wb_block:RegionCharlottesville  
##                                0.8106                                -0.5066  
##        dissim_wb_block:RegionRichmond  
##                               -0.3735
#The (Black) Isolation Index

cvl_rva_measures_Spatial %>% 
  ggplot(aes(x = iso_b_block, y = RentTaxRatio)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") +
  facet_wrap(~Region)

lm(RentTaxRatio ~ iso_b_block:Region, data = cvl_rva_measures_Spatial) #0.3226
## 
## Call:
## lm(formula = RentTaxRatio ~ iso_b_block:Region, data = cvl_rva_measures_Spatial)
## 
## Coefficients:
##                       (Intercept)  iso_b_block:RegionCharlottesville  
##                            0.5246                             0.2395  
##        iso_b_block:RegionRichmond  
##                            0.3164